home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / cat / boyermoo.i < prev    next >
Text File  |  1997-10-26  |  7KB  |  161 lines
  1. IMPLEMENTATION MODULE BoyerMoore;
  2.  
  3. (*$R-,S-,J+*)
  4. (*==============================================================*
  5.  * Modul:               Stringsuchen nach Boyer-Moore           *
  6.  * Autor:               Johannes G”ttker-Schnetmann             *
  7.  * erstellt am:         18.04.1992                              *
  8.  * letzte Žnderung am:  19.04.1992                              *
  9.  * Version:             1.0                                     *
  10.  * Interne Version:     V#0001                                  *
  11.  *==============================================================*
  12.  
  13.  *----------------------------------------------------------------------------
  14.  * Datum    Vers. Autor  Žnderung (Arbeitsbericht)                            
  15.  *----------------------------------------------------------------------------
  16.  *----------------------------------------------------------------------------
  17.  *)
  18.  
  19. (*
  20. TYPE LongString = ARRAY[0..MAX(LONGINT)] OF CHAR;
  21. TYPE longPtr    = POINTER TO longString;
  22.  
  23. TYPE tableType  = ARRAY[0..377C] OF INTEGER;
  24.     (* Tabelle der Zeichenpositionen im String (von hinten) *)
  25. *)
  26.  
  27. PROCEDURE LCAP (ch: CHAR; gross : BOOLEAN): CHAR;
  28. BEGIN
  29.   IF gross THEN
  30.     RETURN CAP (ch)
  31.   ELSE RETURN ch;
  32.   END;
  33. END LCAP;
  34.  
  35. PROCEDURE LCAPS (VAR s: ARRAY OF CHAR; L: INTEGER);
  36. VAR i:      INTEGER;
  37. BEGIN
  38.   IF L > 0 THEN
  39.     FOR i := 0 TO L - 1 DO
  40.       s [i] := LCAP (s [i], TRUE);
  41.     END (* FOR *);
  42.   END (* IF *);
  43. END LCAPS;
  44.  
  45. PROCEDURE InitTable(VAR table  : tableType;      (* Tabelle fr Boyer-Moore-Suche *)
  46.                     VAR subStr : ARRAY OF CHAR;  (* Zu suchender String           *)
  47.                         len    : CARDINAL;       (* L„nge dieses Strings          *)
  48.                         gross  : BOOLEAN;        (* grož-klein unterscheiden      *)
  49.                         reverse: BOOLEAN);       (* Suche von hinten nach vorne   *)
  50. (* len muž gr”žer als 0 sein! *)
  51. (* Wenn gross TRUE ist, wird der String entsprechend gewandelt *)
  52. VAR c : CHAR; j : INTEGER;
  53.     l : INTEGER;
  54. BEGIN
  55.   IF ~gross THEN LCAPS(subStr, len); END;
  56.   FOR c := 0C TO 377C DO
  57.     table [c] := len; (* Tabelle vor-initalisieren *)
  58.   END (* FOR *);
  59.   IF reverse 
  60.   THEN
  61.     (* subStr swappen *)
  62.     l := len - 1;
  63.     FOR j := 0 TO (l DIV 2) DO
  64.       c := subStr[j];
  65.       subStr[j] := subStr[l-j];
  66.       subStr[l-j] := c;
  67.     END;
  68.   END;
  69.   (* Fuer jede Position im Suchwort subStr wird unter dem Index des
  70.      jten Zeichens in die Tabelle der Abstand vom Ende des Such-
  71.      wortes eingetragen. *)
  72.   FOR j := 0 TO INTEGER(len)-2 DO
  73.   (* bis len-1 w„ren alle Arrayelemente, die letzte stimmt aber auch so schon *)
  74.     table [subStr [j]] := INTEGER(len) - j - 1;
  75.   END (* FOR *);
  76.   IF reverse 
  77.   THEN
  78.     (* subStr swappen *)
  79.     l := len - 1;
  80.     FOR j := 0 TO (l DIV 2) DO
  81.       c := subStr[j];
  82.       subStr[j] := subStr[l-j];
  83.       subStr[l-j] := c;
  84.     END;
  85.   END;
  86. END InitTable;
  87.  
  88. PROCEDURE Pos (start  : LONGINT;         (* Startposition im verwendeten Puffer *)
  89.                str    : longPtr;         (* Zeiger auf den Pufferbereich        *)
  90.                pLen   : LONGINT;         (* L„nge dieses Bereiches              *)
  91.            REF substr : ARRAY OF CHAR;   (* gesuchter String                    *)
  92.                len    : INTEGER;         (* L„nge dieses Strings                *)
  93.                gross  : BOOLEAN;         (* gross-klein unterscheiden?          *)
  94.            REF table  : tableType): LONGINT; (* Mit InitTable angelegte Tabelle *)
  95. (* Da die zu verarbeitenden Speicherbl”cke auch recht grož werden k”nnen sollen :-) *)
  96. (* hier die Deklaration als LONGINT. Man k”nnte die Suche notfalls auch stckeln,   *)
  97. (* dann k”nnte es aber Probleme geben, wenn der zu suchende String gerade auf der   *)
  98. (* Blockgrenze steht. L”sung dazu: Einfach um 32k - Stringl„nge nur vorrcken, das  *)
  99. (* w„re mir aber trotzdem im Moment etwas zuviel Aufwand.                           *)
  100. VAR (*$Reg *) index, k, j : LONGINT;
  101.     ch:             CHAR;
  102.     res : LONGINT;
  103.         
  104. BEGIN
  105.   IF LONGINT(LONG(len)) > pLen THEN RETURN pLen+1 END;
  106.   index := LONGINT(LONG(len)) + start;
  107.   (* Index, bei dem die Suche startet (Wortende) *)
  108.   REPEAT
  109.     j := len; k := index; (* Laufindizes setzen *)
  110.     REPEAT
  111.       DEC (k); DEC (j);
  112.     UNTIL (j < 0) OR (substr[SHORT(j)] # LCAP(str^[k], ~gross));
  113.       (* vergleicht substr[j] mit str[k] bis Ungleichheit oder
  114.          Suchstring erschoepft *)
  115.     IF (j >= 0) THEN INC(index, LONGINT(LONG(table[LCAP(str^[index-1], ~gross)])));
  116.     END (* IF nicht gefunden *);
  117.   UNTIL (j < 0) OR (index > pLen);
  118.   IF (j < 0) & (index <= pLen) THEN
  119.     RETURN index - LONGINT(LONG(len));
  120.   ELSE
  121.     RETURN pLen + 1;
  122.   END (* IF *);
  123. END Pos;
  124.  
  125. PROCEDURE BackPos (start  : LONGINT;         (* Startposition im verwendeten Puffer *)
  126.                    str    : longPtr;         (* Zeiger auf den Pufferbereich        *)
  127.                    pLen   : LONGINT;         (* L„nge dieses Bereiches              *)
  128.                REF substr : ARRAY OF CHAR;   (* gesuchter String                    *)
  129.                    len    : INTEGER;        (* L„nge dieses Strings                *)
  130.                    gross  : BOOLEAN;         (* gross-klein unterscheiden?          *)
  131.                REF table  : tableType): LONGINT; (* Mit InitTable angelegte Tabelle *)
  132. (* Da die zu verarbeitenden Speicherbl”cke auch recht grož werden k”nnen sollen :-) *)
  133. (* hier die Deklaration als LONGINT. Man k”nnte die Suche notfalls auch stckeln,   *)
  134. (* dann k”nnte es aber Probleme geben, wenn der zu suchende String gerade auf der   *)
  135. (* Blockgrenze steht. L”sung dazu: Einfach um 32k - Stringl„nge nur vorrcken, das  *)
  136. (* w„re mir aber trotzdem im Moment etwas zuviel Aufwand.                           *)
  137. VAR (*$Reg*)index, k, j : LONGINT;
  138.     (*$Reg*)ch:             CHAR;
  139. BEGIN
  140.   IF LONGINT(LONG(len)) > pLen THEN RETURN pLen+1 END;
  141.   index := start;
  142.       (* Index, bei dem die Suche startet (Wortende) *)
  143.   REPEAT
  144.     j := 0; k := index; (* Laufindizes setzen *)
  145.     WHILE (j < LONG(len)) & (substr[SHORT(j)] = LCAP(str^[k], ~gross)) DO
  146.       INC (k); INC(j);
  147.     END;
  148.       (* vergleicht substr[j] mit str[k] bis Ungleichheit oder
  149.          Suchstring erschoepft *)
  150.     IF (j < LONG(len)) THEN DEC(index, LONGINT(LONG(table[LCAP(str^[index], ~gross)])));
  151.     END (* IF nicht gefunden *);
  152.   UNTIL (j >= LONG(len)) OR (index < 0);
  153.   IF (j >= LONG(len)) & (index >= 0) THEN
  154.     RETURN index;
  155.   ELSE
  156.     RETURN pLen + 1;
  157.   END (* IF *);
  158. END BackPos;
  159.  
  160. END BoyerMoore.
  161.